This recreates the Urban Institute’s Emergency Rental Assistance Priority Index for Louisville. The original index compares Louisville to the rest of Kentucky. At Greater Louisville Project, we think the more appropriate comparison is to our other peer cities. While the maps below show Louisville, the index values are based on a comparison to all census tracts in the core counties of our peer cities.
Greater Louisville Project has also aggregated the data up to the metro council district level. That data is available in both maps and tables.
In addition to the indexes, the indicators that make up the indexes are also mapped below. Navigation is based on tabs, so clicking on the small blue titles brings up the map related to each title.
library(tidyverse)
library(rgdal)
library(sf)
library(viridis)
library(magrittr)
df <- read_csv("housing_index_raw.csv")
# Filter to just peers
df_peer <- df %>%
filter(county_fips %in% c("1073", "18097", "21111", "26081", "29095", "29189",
"29510", "31055", "37081", "37119", "39049", "39061",
"40109", "40143", "45045", "47037", "47093", "47157")) %>%
select(-contains("z_score"), -contains("index")) #drop index and z_score terms so we can recreate them
# Make z scores
make_z <- function(x){
x <- (x - mean(x)) / sd(x)
}
df_z <- df_peer %>%
mutate(across(where(is.numeric), make_z, .names = "z_{.col}"))
df_index <- df_z %>%
mutate(
housing_instability_index = z_perc_poverty_12mnth * .2 + z_perc_renters * .2 + z_perc_cost_burdened_under_35k * .2 + z_perc_overcrowding_renter_1.50_or_more * .2 + z_perc_unemployed_laborforce * .2,
covid_index = z_perc_no_hinsure * .5 + z_perc_low_income_jobs_lost * .5,
equity_index = z_perc_person_of_color * .5 + z_perc_30hamfi * .167 + z_perc_public_assistance * .167 + z_perc_foreign_born * .167,
overall_index = housing_instability_index * .5 + covid_index * .1 + equity_index * .4
)
jfco_shp <- readOGR("JC Tracts", layer = "JC Tracts",
GDAL1_integer64_policy = TRUE, verbose = FALSE)
jfco_sf <- st_as_sf(jfco_shp) %>%
mutate(GEOID = str_sub(GEO_ID, start = -11))
jfco_index <- df_index %>%
filter(county_fips == "21111")
# Urban institute includes a greyed out flag for tracts without enough data
# It's easier to set the values to NA because the graphing framework has the ability to easily assign NA a different color
jfco_index <- jfco_index %>%
mutate(across(where(is.numeric), ~if_else(jfco_index$grayed_out == 1, NA_real_, .)))
jfco_sf <- full_join(jfco_sf, jfco_index, by = "GEOID")
# Transform the percents
mult100 <- function(x){
x <- x * 100
}
jfco_sf <- jfco_sf %>%
mutate(across(starts_with("perc_"), mult100))
make_map <- function(indicator, title = "", legend = "", caption = ""){
ggplot(jfco_sf) +
geom_sf(aes(fill={{ indicator }} )) +
scale_fill_gradient(low = "#323844", high = "#d63631", name = "Percent") +
#scale_fill_viridis(na.value = "grey", name = legend) +
theme_bw() +
theme(panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.border = element_blank()) +
labs(title = title,
caption = caption)
}
make_map(overall_index, title = "Rental Insecurity Index",
legend = "Compared to \n other tracts",
caption = "This is the Urban Institute's Emergency Rental Assistance Priority Index modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index")
You can flip through the tabs below to see each of the three subindexes that make up the overall rental index.
make_map(housing_instability_index, title = "Housing Instability Subindex",
legend = "Compared to \n other tracts",
caption = "This is the Urban Institute's Housing Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index")
make_map(covid_index, title = "Covid Instability Subindex",
legend = "Compared to \n other tracts",
caption = "This is the Urban Institute's Covid Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index")
make_map(equity_index, title = "Equity Subindex",
legend = "Compared to \n other tracts",
caption = "This is the Urban Institute's Equity subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index")
make_map(perc_poverty_12mnth, title = "Poverty",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_renters, title = "Percent of Renter Occupied Housing Units",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_cost_burdened_under_35k, title = "Costburdened Households making under 35k",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_overcrowding_renter_1.50_or_more, title = "Overcrowding in Rental Housing",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_unemployed_laborforce, title = "Unemployment",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_no_hinsure, title = "No Health Insurance",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_low_income_jobs_lost, title = "Low Income Jobs Lost to Covid",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_person_of_color, title = "Percent Persons of Color",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_30hamfi, title = "Extremely Low Income",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_public_assistance, title = "Recieving Public Assistance",
legend = "Percent",
caption = "Data from Urban Institute")
make_map(perc_foreign_born, title = "Foreign Born",
legend = "Percent",
caption = "Data from Urban Institute")
# set up fonts
library(showtext)
showtext_auto()
font_add("Montserrat", "Montserrat/Montserrat-Regular.ttf")
font_add("Montserrat Bold", "Montserrat/Montserrat-SemiBold.ttf")
# Ranking graph function
ranking <- function(df, var, plot_title = "",
year = NULL, sex = "total", race = "total",
order = "Descending",
y_title = "Percent", caption_text = "", subtitle_text = "",
bar_label = TRUE, sigfig = 3, accuracy = 0.1,
label_function, alternate_text = NULL,
ranking_colors = TRUE, text_size){
# Copy variable var to a new column for use with the '$' operator
var <- dplyr:::tbl_at_vars(df, vars(!!enquo(var)))
df$var <- df[[var]]
# Filter to sex, race, and year
if ("sex" %in% names(df)) df <- df[df$sex == sex,]
if ("race" %in% names(df)) df <- df[df$race == race,]
if("year" %in% names(df)) {
if (is.null(year)) year <- max(years_in_df(df, var))
df <- df[df$year %in% year,]
if (length(year) > 1) {
df %<>%
group_by_at(df %cols_in% c("MSA", "FIPS")) %>%
summarise(var = mean(var, na.rm = TRUE)) %>%
ungroup()
}
}
# Add peer data if not already present
# if (df_type(df) %in% c("FIPS", "MSA") & "current" %not_in% names(df)) df %<>% pull_peers(add_info = T)
# Sort according to order parameter
if (order %in% c("descending", "Descending")) df %<>% arrange(desc(var))
if (order %in% c("ascending", "Ascending")) df %<>% arrange(var)
df %<>% filter(!is.na(var))
# Create numbered city labels for left side of graph
df %<>%
mutate(
rank = row_number(),
names = paste0(rank, ". ", city))
# Set bar colors
if (ranking_colors) {
# color_values <- c("#96ca4f", "#ffd600", "#db2834")
# color_names <- c("green", "yellow", "red")
# if (order %in% c("descending", "Descending")) {color_names = rev(color_names)}
#
# breaks <- classInt::classIntervals(na.omit(df$var), 3, style = "jenks")
# df$color <- NA
# df$color[df$var <= breaks$brks[2]] <- color_names[1]
# df$color[df$var > breaks$brks[2] & df$var <= breaks$brks[3]] <- color_names[2]
# df$color[df$var > breaks$brks[3]] <- color_names[3]
color_values <- c("#d63631", "#323844")
color_names <- c("gray", "red")
df$color <- "gray"
df$color[df$city == "Louisville"] <- "red"
} else {
df$color <- "blue"
color_values <- "#f58021"
color_names <- "blue"
}
if (order %in% c("descending", "Descending")) color_values = rev(color_values)
# Create numeric labels
# Create numeric labels
if (!missing(label_function)) {
label_text <- df$var %>% signif(sigfig) %>% label_function()
} else if (y_title == "Dollars") {
if(mean(df$var, na.rm = TRUE) > 10000) {
label_text <- df$var %>% signif(sigfig) %>% scales::dollar(accuracy = accuracy, scale = .001, suffix = "k")
} else {
label_text <- df$var %>% signif(sigfig) %>% scales::dollar(accuracy = .01)
}
} else if (stringr::str_detect(y_title, "Percent")) {
label_text <- df$var %>% signif(sigfig) %>% scales::percent(accuracy = accuracy, scale = 1, suffix = "%")
} else {
label_text <- df$var %>% signif(sigfig) %>% scales::comma(accuracy = accuracy)
}
# Set text format, highlight and italicise Louisville text, highlight Louisville bar
df$textcolor <- "#000000"
df$textcolor[df$city == "Louisville"] <- "#000000"
df$textfont <- "Montserrat"
df$textfont[df$city == "Louisville"] <- "Montserrat Bold"
label_color_names <- c("white", "black")
label_color_values <- c("#000000", "#ffffff")
df$label_color <- "white"
df$label_color[df$city == "Louisville"] <- "black"
#df$linecolor <- "#ffffff"
#df$linecolor[df$city == "Louisville"] <- "#00a9b7"
df$lou <- if_else(df$city == "Louisville", 1, 0)
df$text_alignment <- 1.1
if (!is.null(alternate_text)) df$text_alignment[df$rank %in% alternate_text] <- -0.1
### PLOT GRAPH
# Initial plot
p <- ggplot(data = df,
aes(x = factor(names, levels = rev(names)),
y = var,
fill = factor(color, levels = color_names, ordered = TRUE)))
p <- p + guides(fill = FALSE, color = FALSE)
# Add bars
p <- p +
geom_bar(stat = "identity",
size = text_size) +
coord_flip() +
ggthemes::theme_tufte()
p <- p + scale_fill_manual(values = color_values)
#p <- p + scale_color_manual(values = c("#ffffff", "#00a9b7"))
# Add features
title_scale <- min(1, 48 / nchar(plot_title))
p <- p + theme(text = element_text(family = "Montserrat"),
plot.title = element_text(size = 14 * title_scale * text_size, hjust = 0.5, margin = margin(b = 10, unit = "pt")),
axis.text.y = element_text(hjust = 0,
size = 10 * text_size,
color = rev(df$textcolor),
family = rev(df$textfont)),
axis.title.x = element_text(size = 10 * text_size),
axis.ticks = element_blank(),
axis.text.x = element_blank(),
plot.caption = element_text(size = 5 * text_size, lineheight = 0.5))
if(subtitle_text != ""){
p <- p + theme(plot.subtitle = element_text(hjust = 0.5, size = 5 * text_size)) +
labs(subtitle = subtitle_text)
}
# Add numeric labels to bars based on bar_label parameter
if (y_title != "" & bar_label) {
p <- p + geom_text(aes(label = label_text,
hjust = text_alignment,
color = factor(label_color),
family = textfont),
size = 5 * text_size) +
scale_colour_manual(values=c("#000000", "#ffffff"))
}
# Add vertical line to the left side of the bars based on the h_line parameter
if (min(df$var, na.rm = TRUE) < 0) p <- p + geom_hline(yintercept = 0, linetype = "longdash", size = 2)
# Add remaining text
p <- p + labs(title = plot_title, y = y_title,
x = "", caption = caption_text)
p
}
#Data was pulled in Python file get_data.py and written to .csv
df <- read_csv("low_income_renters.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
# Calculate percent of households making under 35k who pay more than 50% of their
# income on rent
df <- df %>%
# select ACS table variables w/ attached GEOID
select(
NAME,
# These are all the peolpe making under 35k (denominator)
B25074_002E,
B25074_011E,
B25074_020E,
# These are all the people making under 35k who pay more than 50% of their income on rent (numerator)
B25074_009E,
B25074_018E,
B25074_027E,
# These are the people making under 35k for whom this metric wasn't computed
# and they therefore need to be subtracted from the denominator
B25074_010E,
B25074_019E,
B25074_028E
) %>%
#rename both county and city to just St. Louis
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
#use summarize across instead to save space and make reusable in a function
summarize(
B25074_002E = sum(B25074_002E),
B25074_011E = sum(B25074_011E),
B25074_020E = sum(B25074_020E),
B25074_009E = sum(B25074_009E),
B25074_018E = sum(B25074_018E),
B25074_027E = sum(B25074_027E),
B25074_010E = sum(B25074_010E),
B25074_019E = sum(B25074_019E),
B25074_028E = sum(B25074_028E)
) %>%
# create cost burden variable w/ calculation
mutate(
perc_cost_burdened_under_35k = (B25074_009E + B25074_018E + B25074_027E) /
(
B25074_002E + B25074_011E + B25074_020E - B25074_010E - B25074_019E -
B25074_028E
),
#cd add
perc_cost_burdened_under_35k =
if_else(
B25074_002E + B25074_011E + B25074_020E == 0,
0,
perc_cost_burdened_under_35k
)
)
# Clean up for graph
df <- df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_cost_burdened_under_35k = 100 * perc_cost_burdened_under_35k)
plt_cost_burdened <- ranking(df, "perc_cost_burdened_under_35k", text_size = 1, order = "ascending",
plot_title = "Cost Burdened Renters in Households Making Under 35k ")
plt_cost_burdened
#Data was pulled in Python file get_data.py and written to .csv
oc_df <- read_csv("overcrowding.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
oc_df <- oc_df %>%
# select ACS table variables w/ attached GEOID
select(NAME, B25014_013E, B25014_012E, B25014_008E) %>%
#rename both county and city to just St. Louis
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
summarize(across(where(is.numeric), sum)) %>%
# create cost burden variable w/ calculation
mutate(perc_overcrowding_renter_1.50_or_more = ((B25014_012E + B25014_013E) / B25014_008E),
perc_overcrowding_renter_1.50_or_more =
if_else(B25014_008E == 0, 0, perc_overcrowding_renter_1.50_or_more))
# Clean up for graph
oc_df <- oc_df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_overcrowding_renter_1.50_or_more = 100 * perc_overcrowding_renter_1.50_or_more)
plt_oc <- ranking(oc_df, "perc_overcrowding_renter_1.50_or_more", text_size = 1, order = "ascending",
plot_title = "Overcrowding")
plt_oc
#Data was pulled in Python file get_data.py and written to .csv
un_df <- read_csv("unemployed.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
un_df <- un_df %>%
# select ACS table variables w/ attached GEOID
select(B12006_055E, B12006_050E, B12006_011E, B12006_006E, B12006_022E, B12006_017E, B12006_033E, B12006_028E, B12006_044E, B12006_039E, B12006_053E, B12006_048E, B12006_009E, B12006_004E, B12006_020E, B12006_015E, B12006_031E, B12006_026E, B12006_042E, B12006_037E, NAME) %>%
# collapse St. Louis into one
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
summarize(across(where(is.numeric), sum)) %>%
# create unemployed variable w/ calculation
mutate(perc_unemployed_laborforce = ((B12006_055E + B12006_050E + B12006_011E + B12006_006E + B12006_022E + B12006_017E + B12006_033E + B12006_028E + B12006_044E + B12006_039E) / (B12006_053E + B12006_048E + B12006_009E + B12006_004E + B12006_020E + B12006_015E + B12006_031E + B12006_026E + B12006_042E + B12006_037E)),
perc_unemployed_laborforce =
if_else(B12006_053E + B12006_048E + B12006_009E + B12006_004E + B12006_020E + B12006_015E + B12006_031E + B12006_026E + B12006_042E + B12006_037E == 0, 0,
perc_unemployed_laborforce))
# Clean up for graph
un_df <- un_df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_unemployed_laborforce = 100 * perc_unemployed_laborforce)
plt_un <- ranking(un_df, "perc_unemployed_laborforce", text_size = 1, order = "ascending",
plot_title = "Unemployed")
plt_un
#Data was pulled in Python file get_data.py and written to .csv
pv_df <- read_csv("poverty.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
pv_df <- pv_df %>%
# select ACS table variables w/ attached GEOID
select(C17002_002E, C17002_003E, C17002_001E, NAME) %>%
# collapse St. Louis into one
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
summarize(across(where(is.numeric), sum)) %>%
# create poverty variable w/ calculation
mutate(perc_poverty_12mnth = ((C17002_002E + C17002_003E) / C17002_001E),
perc_poverty_12mnth =
if_else(C17002_001E == 0, 0, perc_poverty_12mnth))
# Clean up for graph
pv_df <- pv_df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_poverty_12mnth = 100 * perc_poverty_12mnth)
plt_pv <- ranking(pv_df, "perc_poverty_12mnth", text_size = 1, order = "ascending",
plot_title = "Poverty")
plt_pv
# Read in cross walk
tract_to_district <- read_csv("district_tract_crosswalk.csv") %>%
mutate(tract = as.character(tract))
# Join to data
district_level <- df_index %>%
rename(tract = GEOID) %>%
# Remove airport to avoid dividing by zero
filter(tract!= "21111980100") %>%
# join crosswalk data to dataframe
left_join(tract_to_district, by = "tract") %>%
# Group by district
group_by(district) %>%
# join crosswalk data to dataframe
summarise(across(where(is.numeric), ~sum(. * total)), .groups = "drop")
# Shape files
metro_shp <- readOGR("Council_Districts", layer = "council_districts",
GDAL1_integer64_policy = TRUE, verbose = FALSE)
metro_sf <- st_as_sf(metro_shp) %>%
rename(district = coundist)
metro_sf <- full_join(metro_sf, district_level, by = "district")
# Transform the percents
mult100 <- function(x){
x <- x * 100
}
# Replicate binary decision tree to determine most-interior point of polygons
# This runs well enough for me, but nothing appears when I try using it in the code below
buffers <- c()
for(d in 1:26) {
buff_max = -0.06
buff_min = 0
this_buffer = buff_min
this_step = buff_max
current_resolution = 11
while(current_resolution > 10){
#browser()
# Buffer inside the polygon using this_buffer
temp_sf <- st_buffer(metro_sf[d,], dist = this_buffer, singleSide = T)
# Calculate area of polygon
temp_area = st_area(temp_sf) %>% as.numeric()
# If remaining area > 0, enlarge buffer by going away from 0.
# Also record most recent correct buffer and area produced by buffer.
# If remaining area is 0, reduce buffer by going toward 0.
if (temp_area > 0) {
current_result = this_buffer
current_resolution = temp_area
this_buffer = this_buffer + this_step
} else {
this_buffer = this_buffer - this_step
}
# Cut search step in half
this_step = this_step / 2
}
buffers <- c(buffers, current_result)
}
metro_sf <- metro_sf %>%
mutate(across(starts_with("perc_"), mult100))
metro_map <- function(indicator, title = "", legend = "", caption = ""){
ggplot(metro_sf) +
geom_sf(aes(fill={{ indicator }} )) +
# Add District labels
geom_sf_text(aes(label = district), color = "white") +
#geom_sf_text(aes(label = district), family = "Montserrat Bold", fontface = "bold", size = 6, color = "#ffffff",
# fun.geometry = function(x) st_buffer(x, dist = buffers, singleSide = T) %>% st_point_on_surface()) +
scale_fill_gradient(low = "#323844", high = "#d63631", name = legend) +
#scale_fill_viridis(na.value = "grey", name = legend) +
theme_bw() +
theme(panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.border = element_blank()) +
labs(title = title,
caption = caption)
}
metro_map(overall_index, title = "Rental Insecurity Index",
legend = "Compared to \n peer cities",
caption = "This is the Urban Institute's Emergency Rental Assistance Priority Index modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky).")
metro_map(housing_instability_index, title = "Housing Instability Subindex",
legend = "Compared to \n peer cities",
caption = "This is the Urban Institute's Housing Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index")
metro_map(covid_index, title = "Covid Instability Subindex",
legend = "Compared to \n peer cities",
caption = "This is the Urban Institute's Covid Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index")
metro_map(equity_index, title = "Equity Subindex",
legend = "Compared to \n peer cities",
caption = "This is the Urban Institute's Equity subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index")
metro_map(perc_poverty_12mnth, title = "Poverty",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_renters, title = "Percent of Renter Occupied Housing Units",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_cost_burdened_under_35k, title = "Costburdened Households making under 35k",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_overcrowding_renter_1.50_or_more, title = "Overcrowding in Rental Housing",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_unemployed_laborforce, title = "Unemployment",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_no_hinsure, title = "No Health Insurance",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_low_income_jobs_lost, title = "Low Income Jobs Lost to Covid",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_person_of_color, title = "Percent Persons of Color",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_30hamfi, title = "Extremely Low Income",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_public_assistance, title = "Recieving Public Assistance",
legend = "Percent",
caption = "Data from Urban Institute")
metro_map(perc_foreign_born, title = "Foreign Born",
legend = "Percent",
caption = "Data from Urban Institute")
library(gt)
metro_house_tbl <- metro_sf %>%
st_drop_geometry() %>%
filter(!is.na(district)) %>%
select(district, perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more, housing_instability_index) %>%
#GT fmt_percent expects percents as decimals
mutate(across(starts_with("perc"), ~ ./100)) %>%
gt() %>%
tab_header(title = "Table 1: Housing Indicators",
subtitle = "Components of the Housing Instability Subindex") %>%
fmt_number(columns = vars(housing_instability_index),
n_sigfig = 2,
suffixing = TRUE) %>%
fmt_percent(columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more),
decimals = 0) %>%
cols_label(district = "Metro District",
perc_cost_burdened_under_35k = "Cost Burdened",
perc_renters = "Renting",
perc_poverty_12mnth = "Poverty",
perc_unemployed_laborforce = "Unemployed",
perc_overcrowding_renter_1.50_or_more = "Overcrowding",
housing_instability_index = "Index") %>%
cols_move(columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more, housing_instability_index),
after = vars(district)) %>%
tab_spanner(
label = "Index",
columns = vars(housing_instability_index)
) %>%
tab_spanner(
label = "Percent",
columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more)
) %>%
cols_align(align = "center") %>%
tab_source_note(
source_note = md("Greater Louisville Project")
) %>%
tab_source_note(
source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
) %>%
opt_row_striping(row_striping = TRUE) %>%
opt_table_outline() %>%
tab_options(
table.font.size = px(12),
table.width = pct(50)
)
metro_house_tbl
| Table 1: Housing Indicators | ||||||
|---|---|---|---|---|---|---|
| Components of the Housing Instability Subindex | ||||||
| Metro District | Percent | Index | ||||
| Cost Burdened | Renting | Poverty | Unemployed | Overcrowding | Index | |
| 1 | 47% | 45% | 24% | 12% | 0% | 0.22 |
| 2 | 51% | 50% | 20% | 8% | 3% | 0.33 |
| 3 | 46% | 47% | 26% | 10% | 1% | 0.27 |
| 4 | 35% | 80% | 43% | 17% | 1% | 0.97 |
| 5 | 47% | 57% | 34% | 17% | 1% | 0.73 |
| 6 | 40% | 77% | 43% | 11% | 1% | 0.75 |
| 7 | 64% | 27% | 6% | 3% | 0% | −0.35 |
| 8 | 38% | 32% | 9% | 3% | 1% | −0.46 |
| 9 | 41% | 42% | 10% | 4% | 0% | −0.36 |
| 10 | 47% | 41% | 15% | 6% | 0% | −0.15 |
| 11 | 32% | 29% | 7% | 4% | 1% | −0.49 |
| 12 | 49% | 32% | 12% | 6% | 2% | −0.16 |
| 13 | 35% | 39% | 17% | 6% | 1% | −0.21 |
| 14 | 50% | 23% | 16% | 5% | 0% | −0.32 |
| 15 | 41% | 55% | 26% | 9% | 1% | 0.28 |
| 16 | 66% | 19% | 5% | 4% | 1% | −0.32 |
| 17 | 64% | 26% | 7% | 3% | 1% | −0.31 |
| 18 | 56% | 37% | 5% | 3% | 1% | −0.29 |
| 19 | 70% | 21% | 4% | 4% | 1% | −0.29 |
| 20 | 47% | 17% | 4% | 3% | 1% | −0.57 |
| 21 | 50% | 49% | 22% | 6% | 1% | 0.077 |
| 22 | 36% | 21% | 6% | 3% | 2% | −0.51 |
| 23 | 41% | 19% | 6% | 4% | 1% | −0.52 |
| 24 | 48% | 37% | 14% | 5% | 1% | −0.12 |
| 25 | 34% | 34% | 11% | 5% | 1% | −0.39 |
| 26 | 52% | 40% | 12% | 4% | 1% | −0.18 |
| Greater Louisville Project | ||||||
| Metro Council Districts are estimated from tract level data. Data is from the Urban Institute. | ||||||
metro_covid_tbl <- metro_sf %>%
st_drop_geometry() %>%
filter(!is.na(district)) %>%
select(district, perc_no_hinsure, perc_low_income_jobs_lost, covid_index) %>%
#GT fmt_percent expects percents as decimals
mutate(across(starts_with("perc"), ~ ./100)) %>%
gt() %>%
tab_header(title = "Table 2: Covid Indicators",
subtitle = "Components of the Covid Subindex") %>%
fmt_number(columns = vars(covid_index),
n_sigfig = 2,
suffixing = TRUE) %>%
fmt_percent(columns = vars(perc_no_hinsure, perc_low_income_jobs_lost),
decimals = 0) %>%
cols_label(district = "Metro District",
perc_no_hinsure = "No Health Insurance",
perc_low_income_jobs_lost = "Covid Job Loss",
covid_index = "Covid Index") %>%
cols_move(columns = vars(perc_no_hinsure, perc_low_income_jobs_lost, covid_index),
after = vars(district)) %>%
tab_spanner(
label = "Index",
columns = vars(covid_index)
) %>%
tab_spanner(
label = "Percent",
columns = vars(perc_no_hinsure, perc_low_income_jobs_lost)
) %>%
cols_align(align = "center") %>%
tab_source_note(
source_note = md("Greater Louisville Project")
) %>%
tab_source_note(
source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
) %>%
opt_row_striping(row_striping = TRUE) %>%
opt_table_outline() %>%
tab_options(
table.font.size = px(12),
table.width = pct(50)
)
metro_covid_tbl
| Table 2: Covid Indicators | |||
|---|---|---|---|
| Components of the Covid Subindex | |||
| Metro District | Percent | Index | |
| No Health Insurance | Covid Job Loss | Covid Index | |
| 1 | 9% | 9% | −0.18 |
| 2 | 14% | 8% | −0.012 |
| 3 | 10% | 9% | −0.098 |
| 4 | 10% | 10% | −0.011 |
| 5 | 10% | 9% | −0.082 |
| 6 | 11% | 9% | 0.0010 |
| 7 | 6% | 9% | −0.20 |
| 8 | 4% | 9% | −0.34 |
| 9 | 7% | 9% | −0.22 |
| 10 | 9% | 9% | −0.20 |
| 11 | 5% | 9% | −0.41 |
| 12 | 7% | 8% | −0.42 |
| 13 | 13% | 8% | −0.17 |
| 14 | 8% | 8% | −0.42 |
| 15 | 12% | 9% | −0.046 |
| 16 | 4% | 10% | −0.24 |
| 17 | 5% | 10% | −0.16 |
| 18 | 5% | 9% | −0.28 |
| 19 | 3% | 9% | −0.36 |
| 20 | 3% | 8% | −0.49 |
| 21 | 14% | 8% | −0.017 |
| 22 | 5% | 8% | −0.44 |
| 23 | 7% | 8% | −0.38 |
| 24 | 9% | 8% | −0.29 |
| 25 | 8% | 8% | −0.38 |
| 26 | 9% | 9% | −0.17 |
| Greater Louisville Project | |||
| Metro Council Districts are estimated from tract level data. Data is from the Urban Institute. | |||
metro_equity_tbl <- metro_sf %>%
st_drop_geometry() %>%
filter(!is.na(district)) %>%
select(district, perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index) %>%
#GT fmt_percent expects percents as decimals
mutate(across(starts_with("perc"), ~ ./100)) %>%
gt() %>%
tab_header(title = "Table 3: Equity Indicators",
subtitle = "Components of the Equity Subindex") %>%
fmt_number(columns = vars(equity_index),
n_sigfig = 2,
suffixing = TRUE) %>%
fmt_percent(columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born),
decimals = 0) %>%
cols_label(district = "Metro District",
perc_person_of_color = "Person of Color",
perc_30hamfi = "Extremely Low Income",
perc_public_assistance = "Public Assistance",
perc_foreign_born = "Foreign Born",
equity_index = "Index") %>%
cols_move(columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index),
after = vars(district)) %>%
tab_spanner(
label = "Index",
columns = vars(equity_index)
) %>%
tab_spanner(
label = "Percent",
columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index)
) %>%
cols_align(align = "center") %>%
tab_source_note(
source_note = md("Greater Louisville Project")
) %>%
tab_source_note(
source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
) %>%
opt_row_striping(row_striping = TRUE) %>%
opt_table_outline() %>%
tab_options(
table.font.size = px(12),
table.width = pct(50)
)
metro_equity_tbl
| Table 3: Equity Indicators | |||||
|---|---|---|---|---|---|
| Components of the Equity Subindex | |||||
| Metro District | Percent | ||||
| Person of Color | Extremely Low Income | Public Assistance | Foreign Born | Index | |
| 1 | 68% | 43% | 2% | 2% | 0.48 |
| 2 | 69% | 28% | 2% | 18% | 0.67 |
| 3 | 66% | 45% | 4% | 4% | 0.57 |
| 4 | 60% | 50% | 4% | 4% | 0.53 |
| 5 | 74% | 45% | 3% | 1% | 0.63 |
| 6 | 53% | 46% | 3% | 5% | 0.38 |
| 7 | 16% | 11% | 1% | 7% | −0.71 |
| 8 | 7% | 15% | 1% | 3% | −0.92 |
| 9 | 15% | 19% | 2% | 5% | −0.67 |
| 10 | 28% | 28% | 2% | 9% | −0.28 |
| 11 | 23% | 11% | 2% | 8% | −0.53 |
| 12 | 27% | 26% | 3% | 5% | −0.32 |
| 13 | 31% | 23% | 5% | 12% | −0.035 |
| 14 | 15% | 28% | 4% | 3% | −0.51 |
| 15 | 38% | 32% | 5% | 8% | 0.11 |
| 16 | 18% | 8% | 1% | 8% | −0.67 |
| 17 | 25% | 15% | 2% | 10% | −0.43 |
| 18 | 20% | 12% | 1% | 11% | −0.57 |
| 19 | 17% | 14% | 1% | 6% | −0.71 |
| 20 | 16% | 17% | 1% | 4% | −0.74 |
| 21 | 44% | 29% | 2% | 19% | 0.28 |
| 22 | 22% | 13% | 1% | 5% | −0.63 |
| 23 | 23% | 16% | 2% | 6% | −0.54 |
| 24 | 31% | 26% | 3% | 11% | −0.13 |
| 25 | 24% | 20% | 2% | 6% | −0.49 |
| 26 | 26% | 20% | 4% | 13% | −0.19 |
| Greater Louisville Project | |||||
| Metro Council Districts are estimated from tract level data. Data is from the Urban Institute. | |||||
Data is from the Urban Institute’s Emergency Rental Assistance Priority Index and in most cases is tract level census data from 2018. The low income jobs lost to Covid is an Urban Institute constructed indicator. Complete details on the indicators can be found in the technical appendix, but they are summarized here for convenience.